home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / dmoc3d / ctl3d.bas next >
Encoding:
BASIC Source File  |  1995-03-26  |  3.9 KB  |  99 lines
  1. ' Ctl3D.Bas - Control 3D Start and End
  2. ' 94/08/11 Copyright 1994, Larry Rebich, The Bridge, Inc.
  3. ' Start by calling Ctl3D_Start
  4. ' End by calling   Ctl3D_End
  5. ' 95/03/26 Use either Ctl3D or Ctl3DV2
  6. '--------------------------------------------------------
  7.  
  8.     Option Explicit
  9.     DefInt A-Z
  10.     
  11.     Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
  12.     
  13.     Declare Function Ctl3DAutoSubclassV2 Lib "Ctl3Dv2.DLL" Alias "Ctl3DAutoSubclass" (ByVal hInst As Integer) As Integer
  14.     Declare Function Ctl3DRegisterV2 Lib "Ctl3Dv2.DLL" Alias "Ctl3DRegister" (ByVal hInst As Integer) As Integer
  15.     Declare Function Ctl3DUnregisterV2 Lib "Ctl3Dv2.DLL" Alias "Ctl3DUnregister" (ByVal hInst As Integer) As Integer
  16.     Declare Function Ctl3DGetVerV2 Lib "Ctl3Dv2.DLL" Alias "Ctl3DGetVer" () As Integer
  17.  
  18.     Declare Function Ctl3DAutoSubclassV1 Lib "Ctl3D.DLL" Alias "Ctl3DAutoSubclass" (ByVal hInst As Integer) As Integer
  19.     Declare Function Ctl3DRegisterV1 Lib "Ctl3D.DLL" Alias "Ctl3DRegister" (ByVal hInst As Integer) As Integer
  20.     Declare Function Ctl3DUnregisterV1 Lib "Ctl3D.DLL" Alias "Ctl3DUnregister" (ByVal hInst As Integer) As Integer
  21.     Declare Function Ctl3DGetVerV1 Lib "Ctl3D.DLL" Alias "Ctl3DGetVer" () As Integer
  22.     
  23.     Const GWW_HINSTANCE = (-6)
  24.  
  25.     Dim Ctl3D_Open As Integer   'set to true if open
  26.  
  27.     Global Const FileNameCtl3DV1 = "ctl3d.dll"
  28.     Global Const FileNameCtl3DV2 = "ctl3dv2.dll"
  29.     Dim ExistCtl3DV1 As Integer
  30.     Dim ExistCtl3DV2 As Integer
  31.     Global VerV1 As Integer
  32.     Global VerV2 As Integer
  33.  
  34. Sub Ctl3D_End ()
  35.     Rem This Sub is used to end the 3D effects
  36.     Rem IMPORTANT: you must end 3D effects before your app ends
  37.     If Not Ctl3D_Open Then Exit Sub 'not open, so forget it
  38.     Dim inst, ret
  39.     inst = GetWindowWord(Forms(0).hWnd, GWW_HINSTANCE) 'Get the Word of Frm
  40.     If ExistCtl3DV2 Then                ' use V2
  41.         ret = Ctl3DUnregisterV2(inst)   ' Unregister the program.
  42.     Else
  43.         ret = Ctl3DUnregisterV1(inst)   ' Unregister the program.
  44.     End If
  45.     Ctl3D_Open = False
  46. End Sub
  47.  
  48. Sub Ctl3D_Start ()
  49.     ' Use this to start the 3D dialogs
  50.     If Ctl3D_Open Then Exit Sub     'already registered
  51.     ExistCtl3DV1 = DoesCtl3DExist(FileNameCtl3DV1)
  52.     ExistCtl3DV2 = DoesCtl3DExist(FileNameCtl3DV2)
  53.     If ExistCtl3DV2 Or ExistCtl3DV1 Then
  54.     Else
  55.         Exit Sub                    'neither exists
  56.     End If
  57.     If Forms.Count = 0 Then
  58.         Dim Msg As String
  59.         Msg = "There is no loaded form.  "
  60.         Msg = Msg & "To register your app with CTL3D "
  61.         Msg = Msg & "there must be at least one loaded form.  "
  62.         Msg = Msg & Chr$(13) & Chr$(13)
  63.         Msg = Msg & "Use the Load statement to load a form, "
  64.         Msg = Msg & "use Ctl3D_Start, then unload the form."
  65.         MsgBox Msg, 48, "No Form Loaded"
  66.         Exit Sub
  67.     End If
  68.     Dim inst, ret
  69.     inst = GetWindowWord(Forms(0).hWnd, GWW_HINSTANCE)  'Get the Word from Frm
  70.     If ExistCtl3DV2 Then
  71.         ret = Ctl3DRegisterV2(inst)         ' Register program w/ Ctl3d.
  72.         ret = Ctl3DAutoSubclassV2(inst)     ' Subclass the program.
  73.         VerV2 = Ctl3DGetVerV2()   ' Version
  74.     Else
  75.         ret = Ctl3DRegisterV1(inst)           ' Register program w/ Ctl3d.
  76.         ret = Ctl3DAutoSubclassV1(inst)       ' Subclass the program.
  77.         VerV1 = Ctl3DGetVerV1()   ' Version
  78.     End If
  79.     Ctl3D_Open = True
  80. End Sub
  81.  
  82. Function DoesCtl3DEitherExist () As Integer
  83. ' 95/03/12 Test for Both
  84.     If DoesCtl3DExist(FileNameCtl3DV1) Or DoesCtl3DExist(FileNameCtl3DV2) Then
  85.         DoesCtl3DEitherExist = True
  86.     End If
  87. End Function
  88.  
  89. Function DoesCtl3DExist (TheFile As String) As Integer
  90. ' Call this function to check for the existance of Ctl3Dv2.Dll on the user's system
  91.     Dim Ff As String
  92.     Dim Fd As Double
  93.     GetFileFullNameAndDateTime TheFile, Ff, Fd
  94.     If Ff <> "" Then
  95.         DoesCtl3DExist = True
  96.     End If
  97. End Function
  98.  
  99.